home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 012a / lib194.zip / CONVERT.PRG < prev    next >
Text File  |  1992-12-23  |  53KB  |  1,346 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: CONVERT.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 12/04/1992
  5. *-- Notes.....: This is a complete overhaul of the CONVERT program in LIBxxx.ZIP
  6. *--             Jay went through it and did massive work ...
  7. *--             For details on this file (and others in the library) see 
  8. *--             README.TXT.
  9. *-------------------------------------------------------------------------------
  10.  
  11. FUNCTION Roman
  12. *-------------------------------------------------------------------------------
  13. *-- Programmer..: Nick Carlin
  14. *-- Date........: 04/26/1992
  15. *-- Notes.......: A function designed to return a Roman Numeral based on
  16. *--               an Arabic Numeral input ...
  17. *-- Written for.: dBASE III+
  18. *-- Rev. History: 04/13/1988 - original function.
  19. *--               07/25/1991 - Ken Mayer - 1) modified for dBASE IV, 1.1,
  20. *--                             2) updated to a function, and 3) the procedure
  21. *--                             GetRoman was done away with (combined into the
  22. *--                             function).
  23. *--               04/26/1992 - Jay Parsons - shortened (seriously ...)
  24. *-- Calls.......: None
  25. *-- Called by...: Any
  26. *-- Usage.......: Roman(<nArabic>)
  27. *-- Example.....: ? Roman(32)
  28. *-- Returns.....: Roman Numeral (character string) equivalent of Arabic numeral
  29. *--               passed to it. In example:  XXXII
  30. *-- Parameters..: nArabic = Arabic number to be converted to Roman
  31. *-------------------------------------------------------------------------------
  32.  
  33.    parameters nArabic
  34.    private cLetrs,nCount,nValue,cRoman,cGroup,nMod
  35.     
  36.    cLetrs ="MWYCDMXLCIVX"      && Roman digits
  37.    cRoman = ""                 && this is the returned value
  38.    nCount = 0                  && init counter
  39.    do while nCount < 4         && loop four times, once for thousands, once
  40.                                && for each of hundreds, tens and singles
  41.       nValue = mod( int( nArabic /  10 ^ ( 3 - nCount ) ), 10 )
  42.       cGroup = substr( cLetrs, nCount * 3 + 1, 3 )
  43.       nMod = mod( nValue, 5 )
  44.       if nMod = 4
  45.          if nValue = 9                 && 9
  46.             cRoman = cRoman + left( cGroup, 1 ) + right( cGroup, 1 )
  47.          else                          && 4
  48.             cRoman = cRoman + left( cGroup, 2 )
  49.          endif
  50.       else
  51.          if nValue > 4                 && 5 - 8
  52.             cRoman = cRoman + substr( cGroup, 2, 1 )
  53.          endif
  54.          if nMod > 0                   && 1 - 3 and 6 - 8
  55.             cRoman = cRoman + replicate( left( cGroup, 1 ), nMod )
  56.          endif
  57.       endif
  58.       nCount = nCount + 1
  59.    enddo  && while nCounter < 4
  60.     
  61. RETURN cRoman
  62. *-- EoF: Roman()
  63.  
  64. FUNCTION Arabic
  65. *-------------------------------------------------------------------------------
  66. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  67. *-- Date........: 04/26/1992
  68. *-- Notes.......: This function converts a Roman Numeral to an arabic one.
  69. *--               It parses the roman numeral into an array, and checks each 
  70. *--               character ... if the previous character causes the value to 
  71. *--               subtract (for example, IX = 9, not 10) we subtract that value, 
  72. *--               and then set the previous value to 0, otherwise we would get 
  73. *--               some odd values in return.
  74. *--               So far, it works fine.
  75. *-- Written for.: dBASE IV, 1.1
  76. *-- Rev. History: 07/15/1991 - original function.
  77. *--               04/26/1992 - Jay Parsons - shortened.
  78. *-- Calls.......: None
  79. *-- Called by...: Any
  80. *-- Usage.......: Arabic(<cRoman>)
  81. *-- Example.....: ?Arabic("XXIV")
  82. *-- Returns.....: Arabic number (from example, 24)
  83. *-- Parameters..: cRoman = character string containing roman numeral to be
  84. *--               converted.
  85. *-------------------------------------------------------------------------------
  86.  
  87.   parameters cRoman
  88.   private cRom,cLetrs,nLast,nAt,nVal,cChar,nArabic
  89.     
  90.    cRom = ltrim(trim(upper(cRoman))) && convert to all caps in case ...
  91.    cLetrs = "IVXLCDMWY"
  92.    nArabic = 0
  93.    nLast = 0
  94.    do while len( cRom ) > 0
  95.       cChar = right( cRom, 1 )
  96.       nAt = at( cChar, cLetrs )
  97.       nVal= 10 ^ int( nAt/2 ) / iif(nAt/2 = int(nAt/2),2,1)
  98.       do case
  99.          case nAt = 0
  100.             nArabic = 0
  101.             exit
  102.          case nAt >= nLast
  103.             nArabic = nArabic + nVal
  104.             nLast = nAt
  105.          otherwise
  106.             if nAt/2 = int( nAt / 2 )
  107.                nArabic = 0
  108.                exit
  109.             else
  110.                nArabic = nArabic - nVal
  111.             endif
  112.       endcase
  113.       cRom = left( cRom, len( cRom ) - 1 )
  114.    enddo
  115.     
  116. RETURN nArabic
  117. *-- EoF: Arabic()
  118.  
  119. FUNCTION Factorial
  120. *-------------------------------------------------------------------------------
  121. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  122. *-- Date........: 03/01/1992
  123. *-- Notes.......: Factorial of a number; returns -1 if number is not a
  124. *--               positive integer.
  125. *-- Written for.: dBASE IV, 1.1
  126. *-- Rev. History: None
  127. *-- Calls.......: None
  128. *-- Called by...: Any
  129. *-- Usage.......: Factorial(<nNumber>)
  130. *-- Example.....: ? Factorial( 6 )
  131. *-- Returns.....: Numeric = number factorial <in example, 6! or 720>
  132. *-- Parameters..: nNumber = number for which factorial is to be determined
  133. *-------------------------------------------------------------------------------
  134.  
  135.     parameters nNumber
  136.     private nNext, nProduct
  137.     if nNumber # int( nNumber ) .or. nNumber < 1
  138.       RETURN -1
  139.     endif
  140.     nProduct = 1
  141.     nNext = nNumber
  142.     do while nNext > 1
  143.       nProduct = nProduct * nNext
  144.       nNext = nNext - 1
  145.     enddo
  146.     
  147. RETURN nProduct
  148. *-- Eof: Factorial()
  149.                                  
  150. FUNCTION IsPrime
  151. *-------------------------------------------------------------------------------
  152. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  153. *-- Date........: 08/11/1992
  154. *-- Notes.......: Returns .t. if argument is prime positive integer, or .f.
  155. *-- Written for.: dBASE IV, 1.1
  156. *-- Rev. History: 03/11/92 - original function.
  157. *--             : 08/11/92 - revised to return .T. for 2. ( Tea for two? )
  158. *-- Calls.......: None
  159. *-- Called by...: Any
  160. *-- Usage.......: IsPrime(<nNumber>)
  161. *-- Example.....: ? IsPrime( 628321 )
  162. *-- Returns.....: Logical = .t. if prime
  163. *-- Parameters..: nNumber = positive integer to test for being prime
  164. *-------------------------------------------------------------------------------
  165.  
  166.    parameters nNumber
  167.    private nFactor, nLimit, lResult
  168.    if nNumber < 1 .or. nNumber # int( nNumber ) ;
  169.       .or. ( nNumber > 2 .AND. mod( nNumber, 2 ) = 0 )
  170.       RETURN .f.
  171.    endif
  172.    nFactor = 3
  173.    nLimit = sqrt( nNumber )
  174.    lResult = .t.
  175.    do while nFactor <= nLimit
  176.       if mod( nNumber, nFactor ) = 0
  177.          lResult = .f.
  178.          exit
  179.       endif
  180.       nFactor = nFactor + 2
  181.    enddo
  182.  
  183. RETURN lResult
  184. *-- Eof: IsPrime()
  185.  
  186. FUNCTION BankRound
  187. *-------------------------------------------------------------------------------
  188. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  189. *-- Date........: 03/01/1992
  190. *-- Notes.......: Rounds numeric argument to given number of places,
  191. *--               which if positive are decimal places, otherwise
  192. *--               trailing zeroes before the decimal, in accordance
  193. *--               with the special banker's rule that if the value
  194. *--               lost by rounding is exactly halfway between two
  195. *--               possible digits, the final digit expressed will be even.
  196. *-- Written for.: dBASE IV, 1.1
  197. *-- Rev. History: None
  198. *-- Calls.......: None
  199. *-- Called by...: Any
  200. *-- Usage.......: BankRound(<nNumber>,<nPlaces>)
  201. *-- Example.....: ? BankRound( 357.725, 2 )
  202. *-- Returns.....: Numeric = rounded value ( 357.72 in example )
  203. *-- Parameters..: nNumber = numeric value to round
  204. *--               nPlaces = decimal places, negative being powers of 10
  205. *-------------------------------------------------------------------------------
  206.  
  207.     parameters nNumber, nPlaces
  208.     private nTemp
  209.     nTemp = nNumber * 10 ^ nPlaces +.5
  210.     if nTemp = int( nTemp ) .and. nTemp / 2 # int( nTemp / 2 )
  211.       nTemp = nTemp - 1
  212.     endif
  213.     
  214. RETURN int( nTemp ) / 10 ^ nPlaces
  215. *-- Eof: BankRound()
  216.  
  217. FUNCTION Num2Str
  218. *-------------------------------------------------------------------------------
  219. *-- Programmer..: Angus Scott-Fleming (CIS: 75500,3223)
  220. *-- Date........: 06/09/1992
  221. *-- Notes.......: Converts a number to a string like str(), but uses
  222. *--               the ASCII 1/2 and 1/4 characters instead of decimals
  223. *--               where appropriate. Does not require knowing the number of
  224. *--               decimal places first.
  225. *-- Written for.: dBASE IV, 1.1
  226. *-- Rev. History: 06/09/1992 -- Angus took Jay's routine and overhauled it.
  227. *-- Calls.......: None
  228. *-- Called by...: Any
  229. *-- Usage.......: Num2Str(<nNumber>)
  230. *-- Example.....: ? Num2Str( 415.25 )
  231. *-- Returns.....: Character = representation of number ( "415.25" in example )
  232. *-- Parameters..: nNumber = number to represent
  233. *-------------------------------------------------------------------------------
  234.  
  235.     parameters nNumber
  236.     private nInteger, nFraction, cFracstr, nDec
  237.     nInteger = int( nNumber )
  238.     nFraction = abs( nNumber - nInteger )
  239.     if nFraction = 0
  240.         cFracStr = ""
  241.     else
  242.         *-- note that the maximum # of decimals is 18
  243.         cFracStr = ltrim(str(nFraction,19,18))
  244.         do while right(cFracStr,1) = "0"
  245.           cFracstr = left(cFracStr,len(cFracStr)-1)
  246.        enddo
  247.     endif
  248.     
  249. RETURN ltrim( str( nInteger ) ) + cFracstr
  250. *-- Eof: Num2Str()
  251.  
  252. FUNCTION Dec2Hex
  253. *-------------------------------------------------------------------------------
  254. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  255. *-- Date........: 03/01/1992
  256. *-- Notes.......: Converts an unsigned integer ( in decimal notation)
  257. *--               to a hexadecimal string
  258. *-- Written for.: dBASE IV, 1.1
  259. *-- Rev. History: None
  260. *-- Calls.......: None
  261. *-- Called by...: Any
  262. *-- Usage.......: Dec2Hex(<nDecimal>)
  263. *-- Example.....: ? Dec2Hex( 118 )
  264. *-- Returns.....: Character = Hexadecimal equivalent ( "F6" in example )
  265. *-- Parameters..: nDecimal = number to convert
  266. *-------------------------------------------------------------------------------
  267.     
  268.     parameters nDecimal
  269.     private nD, cH
  270.     nD = int( nDecimal )
  271.     cH= ""
  272.     do while nD > 0
  273.       cH = substr( "0123456789ABCDEF", mod( nD, 16 ) + 1 , 1 ) + cH
  274.       nD = int( nD / 16 )
  275.     enddo
  276.     
  277. RETURN iif( "" = cH, "0", cH )
  278. *-- Eof: Dec2Hex()
  279.  
  280. FUNCTION Hex2Dec
  281. *-------------------------------------------------------------------------------
  282. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  283. *-- Date........: 11/26/1992
  284. *-- Notes.......: Converts a hexadecimal character string representing
  285. *--               an unsigned integer to its numeric (decimal) equivalent
  286. *-- Written for.: dBASE IV, 1.1
  287. *-- Rev. History: 03/01/92 - original function.
  288. *--               11/26/92 - modified to eliminate usually-harmless
  289. *--               "substring out of range" error, Jay Parsons
  290. *-- Calls.......: None
  291. *-- Called by...: Any
  292. *-- Usage.......: Hex2Dec(<cHex>)
  293. *-- Example.....: ? Hex2Dec( "F6" )
  294. *-- Returns.....: Numeric = equivalent ( 118 in example )
  295. *-- Parameters..: cHex = character string to convert
  296. *-------------------------------------------------------------------------------
  297.     
  298.     parameters cHex
  299.     private nD, cH
  300.         cH = upper( trim( ltrim ( cHex ) ) ) + "!"
  301.     nD = 0
  302.         do while len( cH ) > 1
  303.       nD = nD * 16 + at( left( cH, 1 ), "123456789ABCDEF" )
  304.       cH = substr( cH, 2 )
  305.     enddo
  306.     
  307. RETURN nD
  308. *-- Eof: Hex2Dec()
  309.  
  310. FUNCTION Hex2Bin
  311. *-------------------------------------------------------------------------------
  312. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  313. *-- Date........: 12/01/1992
  314. *-- Notes.......: Converts a hexadecimal character string representing
  315. *--               an unsigned integer to its binary string equivalent
  316. *-- Written for.: dBASE IV, 1.1
  317. *-- Rev. History: 03/01/92 - original function.
  318. *--               12/01/92 - modified to eliminate usually-harmless
  319. *--               "substring out of range" error, Jay Parsons
  320. *-- Calls.......: None
  321. *-- Called by...: Any
  322. *-- Usage.......: Hex2Bin(<cHex>)
  323. *-- Example.....: ? Hex2Bin( "F6" )
  324. *-- Returns.....: Character = binary string ( "1111 0110" in example )
  325. *-- Parameters..: cHex = character string to convert
  326. *-------------------------------------------------------------------------------
  327.     
  328.     parameters cHex
  329.     private cH, cBits, cNybbles, cVal
  330.         cH = upper( trim( ltrim( cHex ) ) ) + "!"
  331.     cBits = ""
  332.     cNybbles = "00000001001000110100010101100111" ;
  333.               +"10001001101010111100110111101111"
  334.         do while len( cH ) > 1
  335.       cVal = left( cH, 1 )
  336.       if cVal # " "
  337.         cBits = cBits + " " + substr( cNybbles, ;
  338.           at ( cVal, "123456789ABCDEF" ) * 4 + 1, 4 )
  339.       endif
  340.       cH = substr( cH, 2 )
  341.     enddo
  342.     
  343. RETURN iif( "" = cBits, "0", ltrim( cBits ) )
  344. *-- Eof: Hex2Bin()
  345.  
  346. FUNCTION Bin2Hex
  347. *-------------------------------------------------------------------------------
  348. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  349. *-- Date........: 03/01/1992
  350. *-- Notes.......: Converts a binary character string representing
  351. *--               an unsigned integer to its hexadecimal string equivalent
  352. *-- Written for.: dBASE IV, 1.1
  353. *-- Rev. History: None
  354. *-- Calls.......: None
  355. *-- Called by...: Any
  356. *-- Usage.......: Bin2Hex(<cBin>)
  357. *-- Example.....: ? Bin2Hex( "1111 0110" )
  358. *-- Returns.....: Character = hexadecimal string ( "F6" in example )
  359. *-- Parameters..: cBin = character string to convert
  360. *-------------------------------------------------------------------------------
  361.     
  362.     parameters cBin
  363.     private cH, cBits, nBits, nBval, cNext
  364.     cBits = trim( ltrim( cBin ) )
  365.     nBits = len( cBits ) - 1
  366.     do while nBits > 0
  367.       if substr( cBits, nBits, 1 ) $ ", "
  368.         nBval = mod( 4 - mod( len( cBits ) - nBits, 4 ), 4 )
  369.         cBits = stuff( cBits, nBits, 1, replicate( "0", nBval ) )
  370.       endif
  371.       nBits = nBits - 1
  372.     enddo
  373.     cH = ""
  374.     do while "" # cBits
  375.       store 0 to nBits, nBval
  376.       do while nBits < 4
  377.         cNext = right( cBits, 1 )
  378.         nBval = nBval + iif( cNext = "1", 2 ^ nBits, 0 )
  379.         cBits = left( cBits, len( cBits ) - 1 )
  380.         if "" = cBits
  381.           exit
  382.         endif
  383.         nBits = nBits + 1
  384.       enddo
  385.       cH = substr( "0123456789ABCDEF", nBval + 1, 1 ) + cH
  386.     enddo
  387.     
  388. RETURN iif( "" = cH, "0", cH )
  389. *-- Eof: Bin2Hex()
  390.  
  391. FUNCTION Dec2Oct
  392. *-------------------------------------------------------------------------------
  393. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  394. *-- Date........: 03/01/1992
  395. *-- Notes.......: Converts an unsigned integer to its octal string equivalent
  396. *-- Written for.: dBASE IV, 1.1
  397. *-- Rev. History: None
  398. *-- Calls.......: None
  399. *-- Called by...: Any
  400. *-- Usage.......: Dec2Oct(<nDec>)
  401. *-- Example.....: ? Dec2Oct( 118 )
  402. *-- Returns.....: Character = octal string ( "166" in example )
  403. *-- Parameters..: nDec = number to convert
  404. *-------------------------------------------------------------------------------
  405.     
  406.     parameters nDec
  407.     private nD, cO
  408.     nD = int( nDec )
  409.     cO = ""
  410.     do while nD > 0
  411.       cO = substr( "01234567", mod( nD, 8 ) + 1 , 1 ) + cO
  412.       nD = int( nD / 8 )
  413.     enddo
  414.  
  415. RETURN iif( "" = cO, "0", cO )
  416. *-- Eof: Dec2Oct()
  417.  
  418. FUNCTION Oct2Dec
  419. *-------------------------------------------------------------------------------
  420. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  421. *-- Date........: 12/01/1992
  422. *-- Notes.......: Converts an unsigned number in octal, or its string
  423. *--               representation, to a numeric (decimal) value
  424. *-- Written for.: dBASE IV, 1.1
  425. *-- Rev. History: 03/01/92 - original function.
  426. *--               12/01/92 - modified to eliminate usually-harmless
  427. *--               "substring out of range" error, Jay Parsons
  428. *-- Calls.......: None
  429. *-- Called by...: Any
  430. *-- Usage.......: Oct2Dect(<xOct>)
  431. *-- Example.....: ? Oct2Dec( 166 )
  432. *-- Returns.....: Numeric = decimal equivalent ( 118 in example )
  433. *-- Parameters..: xOct = octal character string or number to convert
  434. *-------------------------------------------------------------------------------
  435.     
  436.     parameters xOct
  437.     private nD, cO, cVal
  438.     if type( "xOct" ) $ "NF"
  439.       cO = str( xOct )
  440.     else
  441.       cO = xOct
  442.     endif
  443.         cO = upper( trim( ltrim( cO ) ) ) + "!"
  444.     nD = 0
  445.         do while len( cO ) > 1
  446.       cVal = left( cO, 1 )
  447.       if cVal # " "
  448.         nD = nD * 8 + at( cVal, "1234567" )
  449.       endif
  450.       cO = substr( cO, 2 )
  451.     enddo
  452.     
  453. RETURN nD
  454. *-- Eof: Oct2Dec()
  455.  
  456. FUNCTION Cash2Check
  457. *-------------------------------------------------------------------------------
  458. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  459. *-- Date........: 03/01/1992
  460. *-- Notes.......: Converts a number of dollars and cents to a string of words
  461. *--               appropriate for writing checks.
  462. *--               To correctly evaluate values over 16 decimal places,
  463. *--               SET PRECISION TO a value larger than the default of 16
  464. *--               before calling this function.
  465. *-- Written for.: dBASE IV, 1.1
  466. *-- Rev. History: None
  467. *-- Calls.......: NUM2WORDS()          Function in CONVERT.PRG
  468. *--               THOU2WORDS()         Function in CONVERT.PRG
  469. *-- Called by...: Any
  470. *-- Usage.......: Cash2Check(<nCash>)
  471. *-- Example.....: ? Cash2Check( 348.27 )
  472. *-- Returns.....: Character string equivalent
  473. *-- Parameters..: nCash = money value to convert
  474. *-------------------------------------------------------------------------------
  475.  
  476.     parameters nCash
  477.     private nDollars, nCents, cResult
  478.     nDollars = int( nCash )
  479.     nCents = 100 * round( nCash - nDollars, 2 )
  480.     cResult = trim( Num2Words( nDollars ) )
  481.     if left( cResult, 1 ) = "C"               && deals with oversize number
  482.       RETURN cResult
  483.     endif
  484.     cResult = cResult + " dollar" + iif( nDollars # 1, "s", "" ) + " and "
  485.     if nCents # 0
  486.       RETURN cResult + Thou2Words( nCents )  + " cent" + iif( nCents # 1, "s", "" )
  487.     else
  488.       RETURN cResult + "no cents"
  489.     endif
  490.     
  491. *-- Eof: Cash2Check()
  492.  
  493. FUNCTION Num2Words
  494. *-------------------------------------------------------------------------------
  495. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  496. *-- Date........: 03/01/1992
  497. *-- Notes.......: Converts an integer to a string of words.  Limited, due to
  498. *--               254-character limit of dBASE strings, to numbers less than
  499. *--               10 ^ 15
  500. *-- Written for.: dBASE IV, 1.1
  501. *-- Rev. History: None
  502. *-- Calls.......: THOU2WORDS()         Function in CONVERT.PRG
  503. *-- Called by...: Any
  504. *-- Usage.......: Num2Words(<nNum>)
  505. *-- Example.....: ? Num2Words( 4321568357 )
  506. *-- Returns.....: Character string equivalent
  507. *-- Parameters..: nNum = numeric integer to convert
  508. *-------------------------------------------------------------------------------
  509.     
  510.     parameters nNum
  511.     private nNumleft, nScale, nGroup, cResult
  512.     nNumleft = int( nNum )
  513.     do case
  514.       case abs( nNumleft ) >= 10 ^ 15
  515.         RETURN "Cannot convert a number in or above the quadrillions."    
  516.       case nNumleft = 0
  517.         RETURN "zero"
  518.       case nNumleft < 0
  519.         cResult = "minus "
  520.         nNumleft = -nNumleft
  521.       otherwise 
  522.         cResult = ""
  523.     endcase
  524.     do while nNumleft > 0
  525.       nScale = int( log10( nNumleft ) / 3 )
  526.       nGroup = int( nNumleft / 10 ^ ( 3 * nScale ) )
  527.       nNumleft = mod( nNumleft, 10 ^ ( 3 * nScale ) )
  528.       cResult = cResult + Thou2Words( nGroup )
  529.       if nScale > 0
  530.         cResult = cResult + " " ;
  531.           + trim( substr( "thousandmillion billion trillion", nScale * 8 - 7, 8 ) )
  532.         if nNumleft > 0
  533.           cResult = cResult + ", "
  534.         endif
  535.       endif
  536.     enddo           
  537.     
  538. RETURN cResult
  539. *-- Eof: Num2Words()
  540.  
  541. FUNCTION Thou2Words
  542. *-------------------------------------------------------------------------------
  543. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  544. *-- Date........: 03/01/1992
  545. *-- Notes.......: Converts a positive integer less than 1000 to a string
  546. *--               of characters.
  547. *-- Written for.: dBASE IV, 1.1
  548. *-- Rev. History: None
  549. *-- Calls.......: None
  550. *-- Called by...: Any
  551. *-- Usage.......: Thou2Words(<nNum>)
  552. *-- Example.....: ? Thou2Words( 834 )
  553. *-- Returns.....: Character string equivalent
  554. *-- Parameters..: nNum = numeric integer to convert
  555. *-------------------------------------------------------------------------------
  556.     
  557.     parameters nNum
  558.     private cUnits, cTens, nN, cResult
  559.     cUnits = "one      two      " ;
  560.            + "three    four     " ;
  561.            + "five     six      " ;
  562.            + "seven    eight    " ;
  563.            + "nine     ten      " ;
  564.            + "eleven   twelve   " ;
  565.            + "thirteen fourteen " ;
  566.            + "fifteen  sixteen  " ;
  567.            + "seventeeneighteen " ;
  568.            + "nineteen "
  569.     cTens = "twen thir for  fif  six  seveneigh nine "
  570.     nN = int( nNum )
  571.     if nN = 0
  572.       RETURN "zero"
  573.     endif
  574.     cResult = ""
  575.     if nNum > 99
  576.       cResult = trim( substr(cUnits, int(nNum / 100 ) * 9 - 8, 9 ) ) + " hundred"
  577.       nN = mod( nN, 100 )
  578.       if nN = 0
  579.         RETURN cResult
  580.       else
  581.         cResult = cResult + " "
  582.       endif
  583.     endif
  584.     if nN > 19
  585.       cResult = cResult + trim( substr( cTens, int( nN / 10 ) * 5 - 9, 5 ) ) + "ty"
  586.       nN = mod( nN, 10 )
  587.       if nN = 0
  588.         RETURN cResult
  589.       else
  590.         cResult = cResult + "-"
  591.       endif
  592.     endif
  593.     
  594. RETURN cResult + trim( substr( cUnits, nN * 9 - 8, 9 ) )
  595. *-- Eof: Thou2Words()
  596.  
  597. FUNCTION Ord
  598. *-------------------------------------------------------------------------------
  599. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  600. *-- Date........: 03/01/1992
  601. *-- Notes.......: Converts an integer to ordinal representation by adding
  602. *--               "st", "nd", "rd" or "th" after its digit(s)
  603. *-- Written for.: dBASE IV, 1.1
  604. *-- Rev. History: None
  605. *-- Calls.......: None
  606. *-- Called by...: Any
  607. *-- Usage.......: Ord(<nNum>)
  608. *-- Example.....: ? Ord( 11 )
  609. *-- Returns.....: Character ordinal string equivalent ( "11th" in example )
  610. *-- Parameters..: nNum = numeric integer to convert
  611. *-------------------------------------------------------------------------------
  612.     
  613.     parameters nNum
  614.     private nD
  615.     nD = mod( nNum, 100 ) - 1     && the -1 just happens to simplify what follows
  616.     
  617. RETURN str( nNum ) + iif( mod( nD, 10 ) > 2 .or. abs( nD - 11 ) < 2, ;
  618.    "th", substr( "stndrd", mod( nD, 10 ) * 2 + 1, 2 ) )
  619. *-- Eof: Ord()
  620.  
  621. FUNCTION Dec2Bin
  622. *-------------------------------------------------------------------------------
  623. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  624. *-- Date........: 03/01/1992
  625. *-- Notes.......: Converts an unsigned number to a character
  626. *--               string giving its ASCII binary representation.
  627. *-- Written for.: dBASE IV, 1.1
  628. *-- Rev. History: None
  629. *-- Calls.......: None
  630. *-- Called by...: Any
  631. *-- Usage.......: Dec2Bin(<nNum>,<nPlaces>)
  632. *-- Example.....: ? Dec2Bin( 35, 8 )
  633. *-- Returns.....: Character binary equivalent ( "0010 0011", in example )
  634. *-- Parameters..: nNum = number to convert
  635. *--               nPlaces = number of binary places number is to occupy
  636. *-------------------------------------------------------------------------------
  637.     
  638.     parameters nNum, nPlaces
  639.     private cBits, nN
  640.     cBits= ""
  641.     nN = nNum
  642.     do while len(cBits) < nPlaces
  643.       if nN > 0
  644.         cBits = str( mod( nN, 2 ), 1 ) + cBits
  645.         nN = int( nN / 2 )
  646.       else
  647.         cBits = "0" +cBits
  648.       endif
  649.     enddo
  650.     
  651. RETURN cBits
  652. *-- Eof: Dec2Bin()
  653.  
  654. FUNCTION Frac2Bin
  655. *-------------------------------------------------------------------------------
  656. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  657. *-- Date........: 03/01/1992
  658. *-- Notes.......: Converts the fractional part of an unsigned number
  659. *--               to a character string giving its ASCII binary representation.
  660. *-- Written for.: dBASE IV, 1.1
  661. *-- Rev. History: None
  662. *-- Calls.......: None
  663. *-- Called by...: Any
  664. *-- Usage.......: Frac2Bin(<nNum>,<nPlaces>)
  665. *-- Example.....: ? Frac2Bin( .35, 8 )
  666. *-- Returns.....: Character binary equivalent
  667. *-- Parameters..: nNum = number to convert
  668. *--               nPlaces = number of binary places number is to occupy
  669. *-------------------------------------------------------------------------------
  670.  
  671.     parameters nNum, nPlaces
  672.     private cBits, nN
  673.     cBits = ""
  674.     nN = nNum
  675.     do while len( cBits ) < nPlaces
  676.       if nN > 0
  677.         nN = 2 * nN
  678.         cBits = cBits + str( int( nN ), 1 )
  679.         nN = nN - int( nN )
  680.       else
  681.         cBits = cBits + "0"
  682.       endif
  683.     enddo
  684.     
  685. RETURN cBits
  686. *-- Eof: Frac2Bin()
  687.  
  688. FUNCTION Num2Real
  689. *-------------------------------------------------------------------------------
  690. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  691. *-- Date........: 11/26/1992
  692. *-- Notes.......: Converts a number to the ASCII representation of
  693. *--               its storage in IEEE 4 or 8-byte real format, with least
  694. *--               significant byte (lowest in memory) first.  Provided
  695. *--               for checking the values in .MEM files, or in memory
  696. *--               float-type variables if peeking.
  697. *-- Written for.: dBASE IV Version 1.5
  698. *--               ( may be adapted to earlier versions by requiring fixed
  699. *--               number of parameters.)
  700. *-- Rev. History: 03/01/92 - original function
  701. *--               11/26/92 - revised to call Dec2Mkd(), etc., Jay Parsons
  702. *--               The parameters of the revised version are not the same
  703. *--               as those of the original.
  704. *-- Calls.......: Dec2Mkd()            Function in CONVERT.PRG
  705. *--               Dec2Mks()            Function in CONVERT.PRG
  706. *--               Dec2Hex()            Function in CONVERT.PRG
  707. *-- Called by...: Any
  708. *-- Usage.......: Num2Real(<nNum> [,<nBytes>] )
  709. *-- Example.....: ? Num2Real( 10E100, 8 )
  710. *-- Returns.....: Character string equivalent ( of a blank date, in example )
  711. *-- Parameters..: nNum = number to convert
  712. *--               nBytes = number of bytes in conversion.  Optional,
  713. *--                        will be considered 8 ( long real ) unless
  714. *--                        4 is specified.
  715. *-------------------------------------------------------------------------------
  716.     
  717.         parameters nNum, nBytes
  718.         private cStr, nB, nX, MK
  719.         nB = iif( type( "nBytes" ) = "N" .AND. nBytes = 4, 4, 8 )
  720.         declare MK[ nB ]
  721.         cStr = ""
  722.         if "" # iif( nB = 8, Dec2Mkd( nNum, "MK" ), Dec2Mks( nNum, "MK" ) )
  723.           nX = 1
  724.           do while nX <= nB
  725.             cNext = Dec2Hex( asc( MK[ nX ] ) )
  726.             cStr = cStr + right( "0" + Dec2Hex( asc( MK[ nX ] ) ), 2 ) + " "
  727.             nX = nX + 1
  728.           enddo
  729.         endif
  730.  
  731. RETURN trim( cStr )
  732. *-- Eof: Num2Real()
  733.  
  734. FUNCTION Bin2Dec
  735. *-------------------------------------------------------------------------------
  736. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  737. *-- Date........: 11/25/1992
  738. *-- Notes.......: Converts a string containing a binary value
  739. *--               to its numeric (decimal) equivalent.  Any characters
  740. *--               in the string other than "0" or "1" are ignored.
  741. *-- Written for.: dBASE IV, 1.1
  742. *-- Rev. History: 11/25/92, original function
  743. *-- Calls.......: None
  744. *-- Called by...: Any
  745. *-- Usage.......: Bin2Dec( <cStr )
  746. *-- Example.....: ? Bin2Dec( "1000 0011" )
  747. *-- Returns.....: Numeric = equivalent ( 131 in example )
  748. *-- Parameters..: cStr1 = string holding binary value to convert
  749. *-------------------------------------------------------------------------------
  750.  
  751.         parameters cStr
  752.         private cLeft, cChar, nVal
  753.         nVal = 0
  754.         cLeft = cStr + "!"
  755.         do while len( cLeft ) > 1
  756.           cChar = left( cLeft, 1 )
  757.           cLeft  = substr( cLeft, 2 )
  758.           if cChar $ "01"
  759.             nVal = 2 * nVal + val( cChar )
  760.           endif
  761.         enddo
  762.  
  763. RETURN nVal
  764. *-- Eof: Bin2Dec()
  765.  
  766. FUNCTION Dec2Mkd
  767. *-------------------------------------------------------------------------------
  768. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  769. *-- Date........: 11/26/1992
  770. *-- Notes.......: Converts a numeric value to eight chr() values in array.
  771. *--               See notes to Dec2Mki().
  772. *--               Returns null string if array not declared or declared
  773. *--               with too few elements.
  774. *--               This is roughly equivalent to MKD$() in BASIC.
  775. *--               Concatenation of the array elements gives the value
  776. *--               in IEEE long real format ( low-order byte first.)
  777. *--               From high to low, the 64 bits are:
  778. *--                     1 bit sign, 1 = negative
  779. *--                    11 bits exponent base 2 + 1023
  780. *--                    23 bits mantissa with initial "1." omitted as
  781. *--                             understood.
  782. *--               dBASE uses this format for floats and dates internally
  783. *--               and in .MEM files; obviously, the dBASE float() function
  784. *--               will make the same conversion more quickly, but creates
  785. *--               difficulties in accessing the bytes as converted.
  786. *-- Written for.: dBASE IV, 1.1
  787. *-- Rev. History: 11/26/92, original function
  788. *-- Calls.......: Bin2Dec()  - Function in Convert.prg
  789. *--               Dec2Bin()  - Function in Convert.prg
  790. *--               Frac2Bin() - Function in Convert.prg
  791. *-- Called by...: Any
  792. *-- Usage.......: Dec2Mkd( nVar, cName )
  793. *-- Example.....: ? Dec2Mkd( -1, "MK" )
  794. *-- Returns.....: name of array of which elements [ 1 ] - [ 8 ] contain
  795. *--               chr() values equivalent to bytes of value; or null string.
  796. *-- Parameters..: nVar  = number to convert
  797. *--               cName = name of array to use, which must be public and
  798. *--                       previously declared with enough elements
  799. *-- Side effects: Alters contents of array
  800. *-------------------------------------------------------------------------------
  801.  
  802.         parameters nVar, cName
  803.         private cStr, cBin, nVal, nExp, nMant, nX
  804.         cStr = ""
  805.         if type( "&cName.[ 8 ]" ) # "U"
  806.           cStr = cName
  807.           if nVar = 0
  808.             nX = 1
  809.             do while nX < 9
  810.               &cStr.[ nX ] = chr( 0 )
  811.               nX = nX + 1
  812.             enddo
  813.           else
  814.             cBin = iif( nVar < 0, "1", "0" )
  815.             nVal = abs( nVar )
  816.             nExp = int( log( nVar ) / log( 2 ) )
  817.             nMant = nVal / 2 ^ nExp - 1
  818.             cBin = cBin + Dec2Bin( nExp + 1023, 11 ) + Frac2Bin( nMant, 52 )
  819.             nX = 1
  820.             do while nX < 9
  821.               &cStr.[ nX ] = chr( Bin2Dec( substr( cBin, 65 - nX * 8, 8 ) ) )
  822.               nX = nX + 1
  823.             enddo
  824.           endif
  825.         endif
  826.  
  827. RETURN cStr
  828. *-- EoF: Dec2Mkd()
  829.  
  830. FUNCTION Dec2Mki
  831. *-------------------------------------------------------------------------------
  832. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  833. *-- Date........: 11/26/1992
  834. *-- Notes.......: Converts an integer in the range -32,768 to +32,767
  835. *--               to two chr() values equivalent to the two bytes created
  836. *--               by the BASIC MKI$ function.
  837. *--                     Because of the impossibility of storing a null,
  838. *--               chr( 0 ), as a character in a dBASE string, the chr()
  839. *--               values are stored in the first two elements of an array,
  840. *--               with the low-order byte as element[ 1 ].  Array name must
  841. *--               be passed as second parameter.  Array name will
  842. *--               be returned unless the parameter is out of range or
  843. *--               array has too few elements, in which case the null
  844. *--               string is returned.
  845. *--                     Concatenation of the array elements such as by
  846. *--                 fwrite( <nHandle>,<Arrayname>[ 1 ] )
  847. *--                 fwrite( <nHandle>,<Arrayname>[ 2 ] )
  848. *--               writes the same value as the BASIC MKI$ function.
  849. *--               The same format is used by dBASE for internal storage
  850. *--               of integers within the range, and by C as a signed int.
  851. *-- Written for.: dBASE IV, 1.1
  852. *-- Rev. History: 11/26/92, original function
  853. *-- Calls.......: None
  854. *-- Called by...: Any
  855. *-- Usage.......: Dec2Mki( nInt, cName )
  856. *-- Example.....: ? Dec2Mki( -1, "MK" )
  857. *-- Returns.....: name of array of which elements contain char equivalents,
  858. *--               chr( 255) and chr( 255 ) in example; or null string.
  859. *-- Parameters..: nInt = integer to convert
  860. *--               cName = name of array to use, which must be public and
  861. *--                       previously declared with enough elements
  862. *-- Side effects: Alters contents of array
  863. *-------------------------------------------------------------------------------
  864.  
  865.         parameters nInt, cName
  866.         private nVal, cStr, nX
  867.         cStr = ""
  868.         if type( "&cName.[ 2 ]" ) # "U"
  869.           cStr = cName
  870.           if nInt = int( nInt ) .AND. nInt >= -32768 .AND. nInt <= 32767
  871.             nVal = nInt + iif( nInt < 0, 65536, 0 )
  872.             nX = 1
  873.             do while nX < 3
  874.               &cStr.[ nX ] = chr( mod( nVal, 256 ) )
  875.               nVal = int( nVal / 256 )
  876.               nX = nX + 1
  877.             enddo
  878.           endif
  879.         endif
  880.  
  881. RETURN cStr
  882. *-- EoF: Dec2Mki()
  883.  
  884. FUNCTION Dec2Mkl
  885. *-------------------------------------------------------------------------------
  886. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  887. *-- Date........: 11/26/1992
  888. *-- Notes.......: Converts an integer in the range -2^31 to +2^31 - 1
  889. *--               to four chr() values in array.  See notes to Dec2Mki().
  890. *--               Returns null string if parameter is out of range or
  891. *--               array not declared or declared with too few elements.
  892. *--               This is mostly equivalent to MKL$() in BASIC.
  893. *-- Written for.: dBASE IV, 1.1
  894. *-- Rev. History: 11/26/92, original function
  895. *-- Calls.......: None
  896. *-- Called by...: Any
  897. *-- Usage.......: Dec2Mkl( nInt, cName )
  898. *-- Example.....: ? Dec2Mkl( -1, "MK" )
  899. *-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain
  900. *--               chr() values equivalent to bytes of value; or null string.
  901. *-- Parameters..: nInt = integer to convert
  902. *--               cName = name of array to use, which must be public and
  903. *--                       previously declared with enough elements
  904. *-- Side effects: Alters contents of array
  905. *-------------------------------------------------------------------------------
  906.  
  907.         parameters nInt, cName
  908.         private nVal, cStr, nX
  909.         cStr = ""
  910.         if type( "&cName.[ 4 ]" ) # "U"
  911.           cStr = cName
  912.           if nInt = int( nInt ) .AND. nInt >= -2 ^ 31 .AND. nInt < 2 ^ 31
  913.             nVal = nInt + iif( nInt < 0, 2 ^ 32, 0 )
  914.             nX = 1
  915.             do while nX < 5
  916.               &cStr.[ nX ] = chr( mod( nVal, 256 ) )
  917.               nVal = int( nVal / 256 )
  918.               nX = nX + 1
  919.             enddo
  920.           endif
  921.         endif
  922.  
  923. RETURN cStr
  924. *-- EoF: Dec2Mkl()
  925.  
  926. FUNCTION Dec2Mks
  927. *-------------------------------------------------------------------------------
  928. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  929. *-- Date........: 11/26/1992
  930. *-- Notes.......: Converts a numeric value to four chr() values in array.
  931. *--               See notes to Dec2Mki().
  932. *--               Returns null string if array not declared or declared
  933. *--               with too few elements.
  934. *--               This is mostly equivalent to MKS$() in BASIC.
  935. *--               Concatenation of the array elements gives the value
  936. *--               in IEEE short real format ( low-order byte first.)
  937. *--               From high to low, the 32 bits are:
  938. *--                     1 bit sign, 1 = negative
  939. *--                     8 bits exponent base 2 + 127
  940. *--                    23 bits mantissa with initial "1." omitted as
  941. *--                             understood.
  942. *-- Written for.: dBASE IV, 1.1
  943. *-- Rev. History: 11/26/92, original function
  944. *-- Calls.......: Bin2Dec()  - Function in Convert.prg
  945. *--               Dec2Bin()  - Function in Convert.prg
  946. *--               Frac2Bin() - Function in Convert.prg
  947. *-- Called by...: Any
  948. *-- Usage.......: Dec2Mks( nVar, cName )
  949. *-- Example.....: ? Dec2Mks( -1, "MK" )
  950. *-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain
  951. *--               chr() values equivalent to bytes of value; or null string.
  952. *-- Parameters..: nVar  = number to convert
  953. *--               cName = name of array to use, which must be public and
  954. *--                       previously declared with enough elements
  955. *-- Side effects: Alters contents of array
  956. *-------------------------------------------------------------------------------
  957.  
  958.         parameters nVar, cName
  959.         private cStr, cBin, nVal, nExp, nMant, nX
  960.         cStr = ""
  961.         if type( "&cName.[ 4 ]" ) # "U"
  962.           cStr = cName
  963.           if nVar = 0
  964.             nX = 1
  965.             do while nX < 5
  966.               &cStr.[ nX ] = chr( 0 )
  967.               nX = nX + 1
  968.             enddo
  969.           else
  970.             cBin = iif( nVar < 0, "1", "0" )
  971.             nVal = abs( nVar )
  972.             nExp = int( log( nVar ) / log( 2 ) )
  973.             nMant = nVal / 2 ^ nExp - 1
  974.             cBin = cBin + Dec2Bin( nExp + 127, 8 ) + Frac2Bin( nMant, 23 )
  975.             nX = 1
  976.             do while nX < 5
  977.               &cStr.[ nX ] = chr( Bin2Dec( substr( cBin, 33 - nX * 8, 8 ) ) )
  978.               nX = nX + 1
  979.             enddo
  980.           endif
  981.         endif
  982.  
  983. RETURN cStr
  984. *-- EoF: Dec2Mks()
  985.  
  986. FUNCTION Dec2MSks
  987. *-------------------------------------------------------------------------------
  988. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  989. *-- Date........: 12/01/1992
  990. *-- Notes.......: Converts a numeric value to four chr() values in array.
  991. *--               See notes to Dec2Mki().  USES OBSOLETE MICROSOFT FORMAT.
  992. *--               Returns null string if array not declared or declared
  993. *--               with too few elements.
  994. *--               This is mostly equivalent to MKS$() in old Microsoft BASIC.
  995. *--               Concatenation of the array elements gives the value
  996. *--               as stored in old MicroSoft four-byte real format.
  997. *--               From high to low, the 32 bits are:
  998. *--                     8 bits exponent base 2 + 128
  999. *--                     1 bit sign, 1 = negative
  1000. *--                    23 bits mantissa with initial ".1" omitted as
  1001. *--                             understood.
  1002. *-- Written for.: dBASE IV, 1.1
  1003. *-- Rev. History: 12/01/92, original function
  1004. *-- Calls.......: Bin2Dec()  - Function in Convert.prg
  1005. *--               Dec2Bin()  - Function in Convert.prg
  1006. *--               Frac2Bin() - Function in Convert.prg
  1007. *-- Called by...: Any
  1008. *-- Usage.......: Dec2MSks( nVar, cName )
  1009. *-- Example.....: ? Dec2MSks( -1, "MK" )
  1010. *-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain
  1011. *--               chr() values equivalent to bytes of value; or null string.
  1012. *-- Parameters..: nVar  = number to convert
  1013. *--               cName = name of array to use, which must be public and
  1014. *--                       previously declared with enough elements
  1015. *-- Side effects: Alters contents of array
  1016. *-------------------------------------------------------------------------------
  1017.  
  1018.         parameters nVar, cName
  1019.         private cStr, cBin, nVal, nExp, nMant, nX
  1020.         cStr = ""
  1021.         if type( "&cName.[ 4 ]" ) # "U"
  1022.           cStr = cName
  1023.           if nVar = 0
  1024.             nX = 1
  1025.             do while nX < 5
  1026.               &cStr.[ nX ] = chr( 0 )
  1027.               nX = nX + 1
  1028.             enddo
  1029.           else
  1030.             cBin = iif( nVar < 0, "1", "0" )
  1031.             nVal = abs( nVar )
  1032.             nExp = int( log( nVar ) / log( 2 ) )
  1033.             nMant = nVal / 2 ^ nExp - 1
  1034.             cBin = Dec2Bin( nExp + 129, 8 ) + cBin + Frac2Bin( nMant, 23 )
  1035.             nX = 1
  1036.             do while nX < 5
  1037.               &cStr.[ nX ] = chr( Bin2Dec( substr( cBin, 33 - nX * 8, 8 ) ) )
  1038.               nX = nX + 1
  1039.             enddo
  1040.           endif
  1041.         endif
  1042. RETURN cStr
  1043. *-- EoF: Dec2MSks()
  1044.  
  1045. FUNCTION Mkd2Dec
  1046. *-------------------------------------------------------------------------------
  1047. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1048. *-- Date........: 11/26/1992
  1049. *-- Notes.......: Converts eight bytes storing an IEEE long real value
  1050. *--               ( as saved by the BASIC MKD$ function, e. g. )
  1051. *--               to its numeric (decimal) equivalent.  As usual, the
  1052. *--               eight bytes of the value are stored low-order to high-
  1053. *--               order, and are expected as parameters in that order.
  1054. *--               From high to low, the 64 bits are:
  1055. *--                     1 bit sign, 1 = negative
  1056. *--                    11 bits exponent base 2 + 1023
  1057. *--                    52 bits mantissa with initial "1." omitted as
  1058. *--                             understood.
  1059. *--                    The function is written to require eight separate
  1060. *--               parameters rather than an eight-character string because
  1061. *--               fread() will choke on reading the value as a single
  1062. *--               string if it contains nulls ( chr( 0 ) ).
  1063. *--               This is the equivalent of CVD() in BASIC.
  1064. *-- Written for.: dBASE IV, 1.1
  1065. *-- Rev. History: 11/26/92 - original function
  1066. *-- Calls.......: Bin2Dec() - Function in Convert.prg
  1067. *-- Called by...: Any
  1068. *-- Usage.......: Mkd2Dec( <c1>, . . . <c8> )
  1069. *-- Example.....: ? Mkd2Dec( chr( 0 ), chr( 0 ), chr( 0 ), chr( 0 ), ;
  1070. *--                     chr( 0 ), chr( 0 ), chr( 248 ), chr( 3 )
  1071. *-- Returns.....: Numeric = equivalent ( 1 in example )
  1072. *-- Parameters..: c1 . . . c8 = chars holding value to convert
  1073. *-------------------------------------------------------------------------------
  1074.         parameters c1, c2, c3, c4, c5, c6, c7, c8
  1075.         private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal, nZ
  1076.         nX = 8
  1077.         nZ = 0
  1078.         cBin = ""
  1079.         do while nX > 0
  1080.           cVar = "c" + str( nX, 1 )
  1081.           nVal = asc( &cVar )
  1082.           nZ = nZ + nVal
  1083.           nY = 7
  1084.           do while nY >=0
  1085.             cBin = cBin + iif( nVal >= 2 ^ nY, "1", "0" )
  1086.             nVal = mod( nVal, 2 ^ nY )
  1087.             nY = nY - 1
  1088.           enddo
  1089.           nX = nX - 1
  1090.         enddo
  1091.         if nZ = 0
  1092.           nVal = 0
  1093.         else
  1094.           nSign = iif( left( cBin, 1 ) = "1", -1, 1 )
  1095.           nExp = Bin2Dec( substr( cBin, 2, 11) ) - 1023
  1096.           cMant = "1" + right( cBin, 52 )
  1097.           nVal = Bin2Dec( cMant ) * 2 ^ ( nExp - 52 ) * nSign
  1098.         endif
  1099.  
  1100. RETURN nVal
  1101. *-- EoF: Mkd2Dec()
  1102.  
  1103. FUNCTION Mki2Dec
  1104. *-------------------------------------------------------------------------------
  1105. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1106. *-- Date........: 11/25/1992
  1107. *-- Notes.......: Converts two bytes storing a signed short integer
  1108. *--               ( as saved by the BASIC MKI$ function, e. g. )
  1109. *--               to its numeric (decimal) equivalent.  The format
  1110. *--               accommodates values from 8000 ( -32,768 ) to
  1111. *--               7FFF ( +32,767 ); the low-order byte is stored first
  1112. *--               and is expected as the first parameter.
  1113. *--                     This is the equivalent of CVI() in BASIC.
  1114. *--                     While this could easily be modified to accept
  1115. *--               a two-character string as the parameter, dBASE and
  1116. *--               particularly fread() will have trouble with such a
  1117. *--               string that contains a null ( chr( 0 ) ).
  1118. *-- Written for.: dBASE IV, 1.1
  1119. *-- Rev. History: 11/25/92, original function
  1120. *-- Calls.......: None
  1121. *-- Called by...: Any
  1122. *-- Usage.......: Mki2Dec( <c1>, <c2> )
  1123. *-- Example.....: ? Mki2Dec( chr( 255 ), chr( 255 ) )
  1124. *-- Returns.....: Numeric = equivalent ( -1 in example )
  1125. *-- Parameters..: c1, c2 = chars holding value to convert
  1126. *-------------------------------------------------------------------------------
  1127.         parameters c1, c2
  1128.         private nVal
  1129.         nVal = asc( c1 ) + 256 * asc( c2 )
  1130.         if nVal > 32767
  1131.           nVal = nVal - 65536
  1132.         endif
  1133.  
  1134. RETURN nVal
  1135. *-- EoF: Mki2Dec()
  1136.  
  1137. FUNCTION Mkl2Dec
  1138. *-------------------------------------------------------------------------------
  1139. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1140. *-- Date........: 11/26/1992
  1141. *-- Notes.......: Converts four bytes storing a signed long integer
  1142. *--               ( as saved by the BASIC MKL$ function, e. g. )
  1143. *--               to its numeric (decimal) equivalent.  The low-order
  1144. *--               byte is stored first and is expected as the first
  1145. *--               parameter.
  1146. *--                     This is the equivalent of CVL() in BASIC.
  1147. *--                     While this could easily be modified to accept
  1148. *--               a four-character string as the parameter, dBASE and
  1149. *--               particularly fread() will have trouble with such a
  1150. *--               string that contains a null ( chr( 0 ) ).
  1151. *-- Written for.: dBASE IV, 1.1
  1152. *-- Rev. History: 11/26/92, original function
  1153. *-- Calls.......: None
  1154. *-- Called by...: Any
  1155. *-- Usage.......: Mkl2Dec( <c1>, <c2>, <c3>, <c4> )
  1156. *-- Example.....: ? Mkl2Dec( chr( 255 ), chr( 255 ), chr(255 ), chr( 255) )
  1157. *-- Returns.....: Numeric = equivalent ( -1 in example )
  1158. *-- Parameters..: c1, c2, c3, c4 = chars holding value to convert
  1159. *-------------------------------------------------------------------------------
  1160.  
  1161.         parameters c1, c2, c3, c4
  1162.         private nVal, nX, cVar
  1163.         nVal = 0
  1164.         nX = 4
  1165.         do while nX > 0
  1166.           cVar = "c" + str( nX, 1 )
  1167.           nVal = 256 * nVal + asc( &cVar )
  1168.           nX = nX - 1
  1169.         enddo
  1170.         if nVal >= 2 ^ 31
  1171.           nVal = nVal - 2 ^ 32
  1172.         endif
  1173.  
  1174. RETURN nVal
  1175. *-- EoF: Mkl2Dec()
  1176.  
  1177. FUNCTION Mks2Dec
  1178. *-------------------------------------------------------------------------------
  1179. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1180. *-- Date........: 11/25/1992
  1181. *-- Notes.......: Converts four bytes storing an IEEE short real value
  1182. *--               ( as saved by the BASIC MKS$ function, e. g. )
  1183. *--               to its numeric (decimal) equivalent.  As usual, the
  1184. *--               four bytes of the value are stored low-order to high-
  1185. *--               order, and are expected as parameters in that order.
  1186. *--               From high to low, the 32 bits are:
  1187. *--                     1 bit sign, 1 = negative
  1188. *--                     8 bits exponent base 2 + 127
  1189. *--                    23 bits mantissa with initial "1." omitted as
  1190. *--                             understood.
  1191. *--                    The function is written to require four separate
  1192. *--               parameters rather than a four-character string because
  1193. *--               fread() will choke on reading the value as a single
  1194. *--               string if it contains nulls ( chr( 0 ) ).
  1195. *--               This is the equivalent of CVS() in BASIC.
  1196. *-- Written for.: dBASE IV, 1.1
  1197. *-- Rev. History: 11/25/92, original function
  1198. *-- Calls.......: Bin2Dec() - Function in Convert.prg
  1199. *-- Called by...: Any
  1200. *-- Usage.......: Mks2Dec( <c1>, <c2>, <c3>, <c4> )
  1201. *-- Example.....: ? Mks2Dec( chr( 0 ), chr( 0 ), chr( 128 ), chr( 63 ) )
  1202. *-- Returns.....: Numeric = equivalent ( 1 in example )
  1203. *-- Parameters..: c1, c2, c3, c4 = chars holding value to convert
  1204. *-------------------------------------------------------------------------------
  1205.  
  1206.         parameters c1, c2, c3, c4
  1207.         private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal
  1208.         if asc( c1 ) + asc( c2 ) + asc( c3 ) + asc( c4 ) = 0
  1209.           nVal = 0
  1210.         else
  1211.           nX = 4
  1212.           cBin = ""
  1213.           do while nX > 0
  1214.             cVar = "c" + str( nX, 1 )
  1215.             nVal = asc( &cVar )
  1216.             nY = 7
  1217.             do while nY >=0
  1218.               cBin = cBin + iif( nVal >= 2 ^ nY, "1", "0" )
  1219.               nVal = mod( nVal, 2 ^ nY )
  1220.               nY = nY - 1
  1221.             enddo
  1222.             nX = nX - 1
  1223.           enddo
  1224.           nSign = iif( left( cBin, 1 ) = "1", -1, 1 )
  1225.           nExp = Bin2Dec( substr( cBin, 2, 8 ) ) - 127
  1226.           cMant = "1" + right( cBin, 23 )
  1227.           nVal = Bin2Dec( cMant ) * 2 ^ ( nExp - 23 ) * nSign
  1228.         endif
  1229.  
  1230. RETURN nVal
  1231. *-- EoF: Mks2Dec()
  1232.  
  1233. FUNCTION MSks2Dec
  1234. *-------------------------------------------------------------------------------
  1235. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1236. *-- Date........: 11/28/1992
  1237. *-- Notes.......: Converts four bytes storing an old-style Microsoft
  1238. *--               short real value ( as saved by the BASIC MKS$ function,
  1239. *--               e. g. ) to its numeric (decimal) equivalent.  As usual,
  1240. *--               the four bytes of the value are stored low-order to high-
  1241. *--               order, and are expected as parameters in that order.
  1242. *--               From high to low, the 32 bits are:
  1243. *--                     8 bits exponent base 2 + 128
  1244. *--                     1 bit sign, 1 = negative
  1245. *--                    23 bits mantissa with initial ".1" omitted as
  1246. *--                             understood.
  1247. *--                    The function is written to require four separate
  1248. *--               parameters rather than a four-character string because
  1249. *--               fread() will choke on reading the value as a single
  1250. *--               string if it contains nulls ( chr( 0 ) ).
  1251. *--               This is the equivalent of CVS() in old Microsoft BASIC.
  1252. *-- Written for.: dBASE IV, 1.1
  1253. *-- Rev. History: 11/28/92, original function
  1254. *-- Calls.......: Bin2Dec() - Function in Convert.prg
  1255. *-- Called by...: Any
  1256. *-- Usage.......: MSks2Dec( <c1>, <c2>, <c3>, <c4> )
  1257. *-- Example.....: ? MSks2Dec( chr( 0 ), chr( 0 ), chr( 128 ), chr( 63 ) )
  1258. *-- Returns.....: Numeric = equivalent ( 1 in example )
  1259. *-- Parameters..: c1, c2, c3, c4 = chars holding value to convert
  1260. *-------------------------------------------------------------------------------
  1261.  
  1262.         parameters c1, c2, c3, c4
  1263.         private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal
  1264.         if asc( c1 ) + asc( c2 ) + asc( c3 ) + asc( c4 ) = 0
  1265.           nVal = 0
  1266.         else
  1267.           nX = 4
  1268.           cBin = ""
  1269.           do while nX > 0
  1270.             cVar = "c" + str( nX, 1 )
  1271.             nVal = asc( &cVar )
  1272.             nY = 7
  1273.             do while nY >=0
  1274.               cBin = cBin + iif( nVal >= 2 ^ nY, "1", "0" )
  1275.               nVal = mod( nVal, 2 ^ nY )
  1276.               nY = nY - 1
  1277.             enddo
  1278.             nX = nX - 1
  1279.           enddo
  1280.           nSign = iif( substr( cBin, 9, 1 ) = "1", -1, 1 )
  1281.           nExp = Bin2Dec( left( cBin, 8 ) ) - 128
  1282.           cMant = "1" + right( cBin, 23 )
  1283.           nVal = Bin2Dec( cMant ) * 2 ^ ( nExp - 24 ) * nSign
  1284.         endif
  1285.  
  1286. RETURN nVal
  1287. *-- EoF: MSks2Dec()
  1288.  
  1289. FUNCTION Ordinal
  1290. *-------------------------------------------------------------------------------
  1291. *-- Programmer..: Jay Parsons (USSBBS, CIS 70160,340)
  1292. *-- Date........: 12/03/1992
  1293. *-- Notes.......: Returns ordinal string for a positive integer < 100.
  1294. *--               For higher numbers, use Num2Words on int( n/100 ), then
  1295. *--               use this on mod( n, 100 ) or if mod( n, 100 ) = 0, add "th" ).
  1296. *-- Written for.: dBASE IV, 1.1
  1297. *-- Rev. History: 11/19/1992 - original function
  1298. *--               12/03/1992 - Jay Parsons - changed notes and variable names,
  1299. *--                            replaced five lines with an "iif" line
  1300. *-- Calls.......: None
  1301. *-- Called by...: Any
  1302. *-- Usage.......: Ordinal( <nNum> )
  1303. *-- Example.....: ? Ordinal( 31 )          && returns "thirty-first"
  1304. *-- Returns.....: String giving ordinal value ( position ) of number, or null
  1305. *-- Parameters..: nNum = integer > 0 and < 100
  1306. *-------------------------------------------------------------------------------
  1307.  
  1308.     parameters nNum
  1309.     private cUnits, cTeens, cDecades, nRest, cOrd
  1310.     *-- 6       123456123456123456123456123456123456123456123456123456
  1311.     cUnits =   "     four  fif   six   seven eigh  nin   ten   eleventwelf "
  1312.     *-- 5       1234512345123451234512345123451234512345
  1313.     cTeens =   "    thir four fif  six  seveneigh nine  "
  1314.     cDecades = "    twen thir for  fif  six  seveneigh nine"
  1315.  
  1316.     nRest = nNum
  1317.     cOrd = ""
  1318.     if nRest # int( nRet ) .OR. nRest < 1 .OR. nRest > 99
  1319.         nRest = 0
  1320.     endif
  1321.  
  1322.     if nRest > 19
  1323.         cOrd = trim( substr( cDecades, 5 * ( int( nRest / 10 ) - 1 ), 5 ) ) ;
  1324.                + "t"
  1325.         nRest = mod( nRest, 10 )
  1326.         cOrd = cOrd + iif( nRest = 0, "ieth", "y-" )
  1327.     endif
  1328.  
  1329.     do case
  1330.         case nRest > 12
  1331.             cOrd = cOrd + trim( substr( cTeens, 5 * ( nRest - 12 ), 5 ) ) ;
  1332.                    + "teenth"
  1333.         case nRest > 3
  1334.             cOrd = cOrd + trim( substr( cUnits, 6 * ( nRest - 3 ), 6 ) ) + "th"
  1335.         case nRest > 0
  1336.             cOrd = cOrd ;
  1337.                    + trim( substr( "     first secondthird ", 6 * nRest, 6 ) )
  1338.      endcase
  1339.  
  1340. RETURN cOrd
  1341. *-- EoF() Ordinal
  1342.  
  1343. *-------------------------------------------------------------------------------
  1344. *-- EoP: CONVERT.PRG
  1345. *-------------------------------------------------------------------------------
  1346.